home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1998 May / EnigmA AMIGA RUN 27 (1998)(G.R. Edizioni)(IT)[!][issue 1998-05].iso / earcd / sinclair-ql / restore_tas_bas < prev    next >
Text File  |  1998-02-11  |  9KB  |  278 lines
  1. 10  TURBO_objfil "ram1_RESTORE_TAS_task"
  2. 11  TURBO_taskn "RESTORE_TAS"
  3. 12  TURBO_repfil "scr"
  4. 13  TURBO_windo 0
  5. 14  TURBO_diags 'omit'
  6. 15  TURBO_struct "S"
  7. 16  TURBO_model "<"
  8. 17  TURBO_objdat 4
  9. 18  TURBO_optim "R"
  10. 19 :
  11. 1000 REMark ------------------------------
  12. 1010 REMark RESTORE_TAS_bas - Mark J Swift
  13. 1020 REMark ...Turbo tweaks - SNG
  14. 1070 REMark ------------------------------
  15. 1080 :
  16. 1170 DIM InFile$(100),OutFile$(100),Rplc$(1),qry$(1)
  17. 1180 OPEN#3;"Con_456x174a28x12"
  18. 1190 OPEN#4;"Scr_104x12a362x20"
  19. 1210 REPeat main_loop
  20. 1215  RETRY_HERE
  21. 1220  IF COMPILED
  22. 1221   WHEN ERRor 
  23. 1222    PRINT #3\\"Error: "
  24. 1223    REPORT #3,ERNUM
  25. 1224    INPUT #3;\" Press ENTER to re-start.";Rplc$
  26. 1225    RETRY
  27. 1226   END WHEN 
  28. 1227  END IF 
  29. 1229  WINDOW#3;456,174,28,12:PAPER#3;0:INK#3;7:CLS#3:BORDER#3;3,2:BORDER#3;2,0:BORDER#3;1,2:WINDOW#3;438,160,36,19
  30. 1230  CSIZE#3;2,1:PRINT#3;"RESTORE_TAS V1.10":CSIZE#3;0,0
  31. 1240  PRINT#3;"Puts TAS instruction back into files ";
  32. 1250  PRINT#3;"where TAS has been replaced"
  33. 1260  PRINT#3;\"* Note: Do not apply to originals!"
  34. 1270  CLS#4:BORDER#4;1,7:INK#4;4
  35. 1280  INPUT#3;\"Input file name  >";InFile$
  36. 1290  IF InFile$="" THEN EXIT main_loop
  37. 1300  INPUT#3;"Output file name >";OutFile$
  38. 1310  IF OutFile$="" THEN EXIT main_loop
  39. 1320  WINDOW#3;438,60,36,119:CLS#3
  40. 1330  OPEN_IN#6;InFile$
  41. 1340  fl=FLEN(#6):ft=FTYP(#6):IF ft THEN fd=FDAT(#6)
  42. 1350  CLOSE#6
  43. 1360  base=ALCHP(fl)
  44. 1370  IF base>0 THEN 
  45. 1380   LBYTES InFile$,base
  46. 1390  ELSE 
  47. 1400   PRINT#3;\"Out of memory!"
  48. 1410   EXIT main_loop
  49. 1420  END IF 
  50. 1430  REMark do it
  51. 1440  EA_mask=HEX('003F')
  52. 1450  LINEF_mask=HEX('FFC0')-HEX('10000')
  53. 1460  TAS_inst=HEX('4AC0')
  54. 1470  TAS_mask=HEX('FFC0')-HEX('10000')
  55. 1480  BSR_inst=HEX('6100')
  56. 1490  BSR_mask=HEX('FF00')-HEX('10000')
  57. 1500  RTS_inst=HEX('4E75')
  58. 1510  TST_inst=HEX('4A00')
  59. 1520  TST_mask=HEX('FFC0')-HEX('10000')
  60. 1530  BSET_inst=HEX('08C0')
  61. 1540  BSET_mask=HEX('FFC0')-HEX('10000')
  62. 1550  NoRpc%=0:Rplc$=""
  63. 1560  PRINT#3;\"Pass 1...searching for extended CODE fixes"\\
  64. 1570  p=0
  65. 1580  REPeat Restore_loop
  66. 1590   IF p>=fl THEN EXIT Restore_loop
  67. 1600   FOR N=1 TO 256
  68. 1610    pk=PEEK_W(base+p)
  69. 1620    IF ((pk&&BSR_mask)=BSR_inst)THEN 
  70. 1630     disp=PEEK(base+p+1)
  71. 1640     IF NOT(disp&&1) THEN 
  72. 1650     IF disp=0 THEN 
  73. 1660      disp=PEEK_W(base+p+2)
  74. 1670     END IF 
  75. 1680     lb=p+2+disp
  76. 1690     pk=PEEK_W(base+lb)
  77. 1700     IF ((pk&&TST_mask)=TST_inst)THEN 
  78. 1710      ea=pk && EA_mask
  79. 1720      SELect ON ea
  80. 1730      =0 TO 7 : REMark dn - can cope with this!
  81. 1740       IF Restore_ARI THEN 
  82. 1750        PRINT#3;HEX$(p,32);" TAS d";ea&&7;
  83. 1760        Restore_INST
  84. 1770        IF lb<fl THEN fl=lb
  85. 1780       END IF 
  86. 1790      =16 TO 23 : REMark  (an)
  87. 1800       IF Restore_ARI THEN 
  88. 1810        PRINT#3;HEX$(p,32);" TAS (a";ea&&7;")";
  89. 1820        Restore_INST
  90. 1830        IF lb<fl THEN fl=lb
  91. 1840       END IF 
  92. 1850      =24 TO 31 : REMark  (an)+
  93. 1860       IF Restore_ARI THEN 
  94. 1870        PRINT#3;HEX$(p,32);" TAS (a";ea&&7;")+";
  95. 1880        Restore_INST
  96. 1890        IF lb<fl THEN fl=lb
  97. 1900       END IF 
  98. 1910      =32 TO 39 : REMark  -(an)
  99. 1920       IF Restore_ARI THEN 
  100. 1930        PRINT#3;HEX$(p,32);" TAS -(a";ea&&7;")";
  101. 1940        Restore_INST
  102. 1950        IF lb<fl THEN fl=lb
  103. 1960       END IF 
  104. 1970      =40 TO 47 : REMark d(an)
  105. 1980       IF Restore_ARID THEN 
  106. 1990        PRINT#3;HEX$(p,32);" TAS ";HEX$(PEEK_W(base+lb+2),16);"(a";ea&&7;")";
  107. 2000        Restore_INST
  108. 2010        POKE_W base+p+2,PEEK_W(base+lb+2)
  109. 2020        p=p+2
  110. 2030        IF lb<fl THEN fl=lb
  111. 2040       END IF 
  112. 2050      =48 TO 55 : REMark d(an,a/dn)
  113. 2060       IF Restore_ARID THEN 
  114. 2070        PRINT#3;HEX$(p,32);" TAS $";HEX$(PEEK(base+lb+3),8);"(a";ea&&7;",";"da"(1+(INT(PEEK(base+lb+2)/128)&&1));INT(PEEK(base+lb+2)/16)&&7;".";"wl"(1+(INT(PEEK(base+lb+2)/8)&&1));")";
  115. 2080        Restore_INST
  116. 2090        POKE_W base+p+2,PEEK_W(base+lb+2)
  117. 2100        p=p+2
  118. 2110        IF lb<fl THEN fl=lb
  119. 2120       END IF 
  120. 2130      =56 : REMark $.w
  121. 2140       IF Restore_ARID THEN 
  122. 2150        PRINT#3;HEX$(p,32);" TAS $";HEX$(PEEK_W(base+lb+2),16);
  123. 2160        Restore_INST
  124. 2170        POKE_W base+p+2,PEEK_W(base+lb+2)
  125. 2180        p=p+2
  126. 2190        IF lb<fl THEN fl=lb
  127. 2200       END IF 
  128. 2210      =57 : REMark $.l
  129. 2220       IF RESTORE_ABSL THEN 
  130. 2230        PRINT#3;HEX$(p,32);" TAS $";HEX$(PEEK_L(base+lb+2),32);
  131. 2240        Restore_INST
  132. 2250        POKE_L base+p+2,PEEK_L(base+lb+2)
  133. 2260        p=p+4
  134. 2270        IF lb<fl THEN fl=lb
  135. 2280       END IF 
  136. 2290      =REMAINDER : REMark impossible
  137. 2300       REMark ignore illegal modes
  138. 2310      END SELect 
  139. 2320     END IF 
  140. 2330     END IF 
  141. 2340    END IF 
  142. 2350    p=p+2
  143. 2360    IF p>=fl THEN EXIT N
  144. 2370   END FOR N
  145. 2380   IF p>fl THEN 
  146. 2390    BLOCK#4;100,10,0,0,4
  147. 2400   ELSE 
  148. 2410    BLOCK#4;INT((p/fl)*100),10,0,0,4
  149. 2420   END IF 
  150. 2430  END REPeat Restore_loop
  151. 2440  p=0
  152. 2450  IF (NoRpc%=0) THEN 
  153. 2460   CLS#4
  154. 2470   PRINT#3;\"Pass 2...searching for Line-A & Line-F fixes"
  155. 2480   PRINT#3;\"TAS fixed prior to QDOS 3.23";
  156. 2490   qry$=WAITKEY$(3,"yn"):PRINT#3
  157. 2500   IF qry$=="N" THEN 
  158. 2510    LINEF_inst=HEX('AE00')-HEX('10000')
  159. 2520   ELSE 
  160. 2530    PRINT#3;\"TAS fixed prior to QDOS 3.20";
  161. 2540    qry$=WAITKEY$(3,"yn"):PRINT#3
  162. 2550    IF qry$=="Y" THEN 
  163. 2560     LINEF_inst=HEX('F000')-HEX('10000')
  164. 2570    ELSE 
  165. 2580     LINEF_inst=HEX('FE00')-HEX('10000')
  166. 2590    END IF 
  167. 2600   END IF 
  168. 2610   REPeat Restore_loop
  169. 2620    IF p>=fl THEN EXIT Restore_loop
  170. 2630    FOR N=1 TO 256
  171. 2640     pk=PEEK_W(base+p)
  172. 2650     IF ((pk&&LINEF_mask)=LINEF_inst)THEN 
  173. 2660      ea=pk && EA_mask
  174. 2670      SELect ON ea
  175. 2680      =0 TO 7 : REMark dn - can cope with this!
  176. 2690       REMark PRINT#3;HEX$(p,32);" TAS d";ea&&7;
  177. 2700       REMark Restore_TAS
  178. 2710      =16 TO 23 : REMark  (an)
  179. 2720       PRINT#3;HEX$(p,32);" TAS (a";ea&&7;")";
  180. 2730       Restore_TAS
  181. 2740      =24 TO 31 : REMark  (an)+
  182. 2750       PRINT#3;HEX$(p,32);" TAS (a";ea&&7;")+";
  183. 2760       Restore_TAS
  184. 2770      =32 TO 39 : REMark  -(an)
  185. 2780       PRINT#3;HEX$(p,32);" TAS -(a";ea&&7;")";
  186. 2790       Restore_TAS
  187. 2800      =40 TO 47 : REMark d(an)
  188. 2810       PRINT#3;HEX$(p,32);" TAS ";HEX$(PEEK_W(base+p+2),16);"(a";ea&&7;")";
  189. 2820       Restore_TAS:p=p+2
  190. 2830      =48 TO 55 : REMark d(an,a/dn)
  191. 2840       PRINT#3;HEX$(p,32);" TAS $";HEX$(PEEK(base+p+3),8);"(a";ea&&7;",";"da"(1+(INT(PEEK(base+p+2)/128)&&1));INT(PEEK(base+p+2)/16)&&7;".";"wl"(1+(INT(PEEK(base+p+2)/8)&&1));")";
  192. 2850       Restore_TAS:p=p+2
  193. 2860      =56 : REMark $.w
  194. 2870       PRINT#3;HEX$(p,32);" TAS $";HEX$(PEEK_W(base+p+2),16);
  195. 2880       Restore_TAS:p=p+2
  196. 2890      =57 : REMark $.l
  197. 2900       PRINT#3;HEX$(p,32);" TAS $";HEX$(PEEK_L(base+p+2),32);
  198. 2910       Restore_TAS:p=p+4
  199. 2920      =REMAINDER : REMark impossible
  200. 2930       REMark ignore illegal address modes
  201. 2940      END SELect 
  202. 2950      IF Rplc$=="Q" THEN EXIT Restore_loop
  203. 2960     END IF 
  204. 2970     p=p+2
  205. 2980     IF p>=fl THEN EXIT N
  206. 2990    END FOR N
  207. 3000    IF p>fl THEN 
  208. 3010     BLOCK#4;100,10,0,0,4
  209. 3020    ELSE 
  210. 3030     BLOCK#4;INT((p/fl)*100),10,0,0,4
  211. 3040    END IF 
  212. 3050   END REPeat Restore_loop
  213. 3060  END IF 
  214. 3070  IF NoRpc% THEN 
  215. 3080   PRINT#3\\"Saving..."
  216. 3090   IF ft THEN 
  217. 3100    DELETE OutFile$
  218. 3110    SEXEC OutFile$,base,fl,fd
  219. 3120   ELSE 
  220. 3130    DELETE OutFile$
  221. 3140    SBYTES OutFile$,base,fl
  222. 3150   END IF 
  223. 3160  ELSE 
  224. 3170   PRINT#3\\"No changes."
  225. 3180  END IF 
  226. 3190  Rplc$=INKEY$(#3,200)
  227. 3200  CLCHP
  228. 3210 END REPeat main_loop
  229. 3220 CLOSE#3
  230. 3230 CLOSE#4
  231. 3240 STOP
  232. 3250 :
  233. 3260 DEFine FuNction Restore_ARI
  234. 3270  RETurn ((PEEK_W(base+lb+2)&&BSET_mask)=BSET_inst) AND (PEEK_W(base+lb+4)=7) AND (PEEK_W(base+lb+6)=RTS_inst)
  235. 3280 END DEFine 
  236. 3290 DEFine FuNction Restore_ARID
  237. 3300  RETurn ((PEEK_W(base+lb+4)&&BSET_mask)=BSET_inst) AND (PEEK_W(base+lb+6)=7) AND (PEEK_W(base+lb+10)=RTS_inst)
  238. 3310 END DEFine 
  239. 3320 DEFine FuNction RESTORE_ABSL
  240. 3330  RETurn (PEEK_W(base+p+4)=NOP_inst)
  241. 3340 END DEFine 
  242. 3350 DEFine PROCedure Restore_INST
  243. 3360  PRINT#3;" restored."
  244. 3370  POKE_W base+p,TAS_inst||ea
  245. 3380  NoRpc%=NoRpc%+1
  246. 3390 END DEFine 
  247. 3400 DEFine PROCedure Restore_TAS
  248. 3410  LOCal get_loop
  249. 3420  IF NOT(Rplc$=="a")
  250. 3430   Rplc$=WAITKEY$(3,"ynaq")
  251. 3440  ELSE 
  252. 3450   PRINT#3;" restored."
  253. 3460  END IF 
  254. 3470  IF Rplc$=="y" OR Rplc$=="a" THEN 
  255. 3480   POKE_W base+p,TAS_inst||ea
  256. 3490   NoRpc%=NoRpc%+1
  257. 3500  END IF 
  258. 3510 END DEFine 
  259. 3520 DEFine FuNction WAITKEY$(Chan%,i$)
  260. 3530  LOCal K$(1),i,l,prompt_loop,get_loop
  261. 3540  PRINT#Chan%;" (";
  262. 3550  i=1:l=LEN(i$)
  263. 3560  REPeat prompt_loop
  264. 3570   PRINT #Chan%;i$(i);:i=i+1
  265. 3580   IF i>l THEN EXIT prompt_loop
  266. 3590   PRINT#Chan%;"/";
  267. 3600  END REPeat prompt_loop
  268. 3610  PRINT#Chan%;")? >";
  269. 3620  CURSEN#Chan%
  270. 3630  REPeat get_loop
  271. 3640   K$=INKEY$(#Chan%,-1)
  272. 3650   IF K$ INSTR i$ THEN EXIT get_loop
  273. 3660  END REPeat get_loop
  274. 3670  CURDIS#Chan%
  275. 3680  PRINT#Chan%;K$
  276. 3690  RETurn K$
  277. 3700 END DEFine 
  278.